Celestin Apprentice 7/Apprentice-Release7.iso/Source Code/Libraries/SAT 2.4.0/SAT/Demo ƒ/HeartQuest demo ƒ/scores.p

Text File | 1997-02-16 | 13.5 KB | 506 lines | [TEXT/PJMM]

{================================================}
{============= Score handling and display ==============}
{================================================}

{ Example file for Ingemars Sprite Animation Toolkit. }
{ © Ingemar Ragnemalm 1992 }
{ See doc files for legal terms for using this code. }

{ This file manages the display and update of the game scores for HeartQuest.}
{ It holds routines for updating high score list, including asking for the name of}
{ the player, high score window etc. When making a new game, you will probably}
{ need to rewrite this unit a lot. }

unit scores;

interface
    uses
{$IFC UNDEFINED THINK_PASCAL}
        Types, Quickdraw, ToolUtils, Resources, Dialogs, Events, Controls,{}
        Windows, TextUtils, QuickDrawText, Memory, MixedMode,
{$ELSEC}
        InterfacesUI,
{$ENDC}
        TransSkel, SAT, Preferences, GameGlobals, SoundConst, CenterStuff;

    var
        score: longint;

    procedure DoHighMenu (item: integer);
    procedure InitScores;                    { Loads the high score list and the high score window. }
    procedure ZeroScore;                     { Call this on New Game! }
    procedure AddScore (amount: longint);    { Call this when the player gets points, or with addscore(0) just to redisplay. }
    procedure AddScoreS (amount: longint);    { Call this to redisplay when the animation isn't running. }
    procedure UpdateHigh;                    { Call this on game over! }

{Also used by sBonus:}
    function Filter (theDialog: DialogPtr; var theEvent: EventRecord; var itemHit: integer): boolean;

implementation

{ Highscore record }
    type
        hsRec = record
                HighScores: array[0..10] of longint;
                HighPlayer: array[0..10] of str15;
            end;
        hsPtr = ^hsRec;
        hsHnd = ^hsPtr;


    var
        hs, hsm: hsHnd; { m is for macho mode }
        hsh, hshm: Handle;

{Filter function for AskHigh, ok = 1 and cancel = 4}
    function Filter (theDialog: DialogPtr; var theEvent: EventRecord; var itemHit: integer): boolean;
        var
            theChar: Char;
            kind: integer;
            item: Handle;
            box: Rect;
    begin
        if theEvent.what = updateEvt then
            begin
                BeginUpdate(theDialog);
                SetPort(theDialog);

                DrawDialog(theDialog);

{Frame ok button}
                GetDialogItem(theDialog, ok, kind, item, box);
                InsetRect(box, -4, -4);
                PenSize(3, 3);
                FrameRoundRect(box, 15, 15);

                EndUpdate(theDialog);

                Filter := false;
                Exit(Filter);
            end;
        if theEvent.what = keyDown then
            begin
                theChar := Char(BitAnd(theEvent.message, charCodeMask));
{if BitAnd(theEvent.modifiers, cmdkey) <> 0 then}
{if theChar = '.' then}
                if ((BitAnd(theEvent.modifiers, cmdkey) <> 0) and (theChar = '.')) or (theChar = char(27)) then {cmd-. or ESC}
                    begin
                        itemHit := cancel;
{Highlight the cancel button}
                        GetDialogItem(theDialog, cancel, kind, item, box);
                        HiliteControl(ControlHandle(item), 1);

                        Filter := true;
                        exit(Filter);
                    end;
                if (theChar = char(13)) or (theChar = char(3)) then
                    begin
                        itemHit := ok;
{Highlight the OK button}
                        GetDialogItem(theDialog, ok, kind, item, box);
                        HiliteControl(ControlHandle(item), 1);

                        Filter := true;
                        exit(Filter);
                    end;
            end;
        Filter := false;
    end; {Filter}

{Put a frame around a dialog item. There are better ways to do this, though. The right way}
{is to draw the frame as response to an update event, not just when opening the dialog.}
    procedure FrameDItem (dLog: DialogPtr; iNum: integer);
        var
            iBox: Rect;
            iType: integer;
            iHandle: Handle;
            oldPenState: PenState;
            tmpp: GrafPtr;
    begin
        GetPort(tmpp);
        SetPort(dLog);
        GetPenState(oldPenState);
        GetDialogItem(dLog, iNum, iType, iHandle, iBox);
        InsetRect(iBox, -4, -4);
        PenSize(3, 3);
        FrameRoundRect(iBox, 16, 16);
        SetPenState(oldPenState);
        SetPort(tmpp);
    end;

{ Ask for players name (at highscore) }
    function AskHigh: str255;
        var
            dialog: DialogPtr;
            oldPort: GrafPtr;
            dRec: DialogRecord;
            itemHit: integer;
            itemHandle: Handle;
            itemType, item: integer;
            itemRect: Rect;
            str: str255;
            levelstr: str255;
{$IFC GENERATINGPOWERPC }
            filterProc: ProcPtr;
{$ENDC}
    begin
        CenterDialog(highDlog);
        GetPort(oldPort);
        dialog := GetNewDialog(highDlog, @dRec, WindowPtr(-1));
        ShowWindow(dialog);
        SelectWindow(dialog);
        SetPort(dialog);

        GetDialogItem(dialog, 3, itemType, itemHandle, itemRect);
        SetDialogItemText(itemHandle, features^^.player);
        SelectDialogItemText(dialog, 3, 0, 32767);
{FrameDItem(dialog, 1);}
        itemHit := -1;

{$IFC GENERATINGPOWERPC }
        filterProc := NewRoutineDescriptor(@Filter, uppModalFilterProcInfo, GetCurrentISA);
{$ENDC}

        while not (itemHit in [ok, cancel]) do
{$IFC GENERATINGPOWERPC }
            ModalDialog(filterProc, itemHit);
{$ELSEC}
        ModalDialog(@Filter, itemHit);
{$ENDC}
        if itemHit = cancel then
            begin
                AskHigh := '';
            end;
        if itemHit = ok then
            begin
                GetDialogItem(dialog, 3, itemType, itemHandle, itemRect);
                GetDialogItemText(itemHandle, str);
                if length(str) > 15 then
                    str := Copy(str, 1, 15);
                features^^.player := str;
                AskHigh := str;
            end;
        CloseDialog(dialog);
        SetPort(oldPort);
    end;

{     High Score window handlers }

    procedure HighUpdate (resized: boolean);
        var
            s: str255;
            i: integer;
    begin
        EraseRect(theHigh^.portrect);
        TextSize(9);

        moveto(10, 20);
        DrawString(MyGetIndString(normalStrID)); {str 9: Normal high score list}
        MoveTo(150, 20);
        DrawString(MyGetIndString(machoStrID)); {str 10: Macho high score list}
        MoveTo(0, 22);
        LineTo(500, 22);
        MoveTo(140, 0);
        LineTo(140, 400);

        for i := 1 to 10 do
            begin
                if not LastMacho and (i = LastHigh) then
                    begin
                        TextFace([bold]);
                        ForeColor(redColor);
                    end;
                moveto(10, i * 18 + 20);
                DrawString(hs^^.HighPlayer[i]);
                moveto(110, i * 18 + 20);
                NumToString(hs^^.HighScores[i], s);
                DrawString(s);

                TextFace([]);
                ForeColor(BlackColor);
                if LastMacho and (i = LastHigh) then
                    begin
                        TextFace([bold]);
                        ForeColor(redColor);
                    end;
                moveto(150, i * 18 + 20);
                DrawString(hsm^^.HighPlayer[i]);
                moveto(250, i * 18 + 20);
                NumToString(hsm^^.HighScores[i], s);
                DrawString(s);

                TextFace([]);
                ForeColor(BlackColor);
            end;
        TextSize(12);
    end;

    procedure HighHalt;
    begin
        CloseWindow(theHigh);
    end;

    function InternalAddScore (amount: longint): Rect;
        var
            s: str255;
            r: Rect;
    begin
        score := score + amount;

        SetPort(gSAT.backScreen.port);
        SetRect(r, gSAT.offSizeH - 49, 14, gSAT.offSizeH - 2, 155);
        OffsetRect(r, 2, 2);
        PaintRoundRect(r, 10, 10);
        OffsetRect(r, -2, -2);
        EraseRoundRect(r, 10, 10);
        FrameRoundRect(r, 10, 10);
        NumToString(Score, s);
        MoveTo(gSAT.offSizeH - 47, 30);
        DrawString(MyGetIndString(scoreStrID)); {str 11: Score: }
        MoveTo(gSAT.offSizeH - 47, 50);
        DrawString(s);

        if not bonusLevelRunning then
            begin
                NumToString(bonus, s);
                MoveTo(gSAT.offSizeH - 47, 80);
                DrawString(MyGetIndString(bonusStrID)); {str 12: Bonus: }
                MoveTo(gSAT.offSizeH - 47, 100);
                DrawString(s);
            end;

        NumToString(level, s);
        MoveTo(gSAT.offSizeH - 47, 130);
        DrawString(MyGetIndString(levelStrID)); {str 13: Level: }
        MoveTo(gSAT.offSizeH - 47, 150);
        DrawString(s);

        r.right := r.right + 2;
        r.bottom := r.bottom + 2;
        InternalAddScore := r;
    end;

    procedure AddScore (amount: longint);
        var
            s: str255;
            r: Rect;
            tmpport: grafptr;
    begin
        GetPort(tmpPort);
        r := InternalAddScore(amount);
        SATBackChanged(r); {Let SAT show it on screen}
        SetPort(tmpPort);
    end;

    procedure AddScoreS (amount: longint);
        var
            s: str255;
            r: Rect;
            tmpport: grafptr;
    begin
        GetPort(tmpPort);
        r := InternalAddScore(amount);
        CopyBits(gSAT.backScreen.port^.portbits, gSAT.wind.port^.portBits, r, r, srcCopy, nil);
        CopyBits(gSAT.backScreen.port^.portbits, gSAT.offScreen.port^.portBits, r, r, srcCopy, nil);
        SetPort(tmpPort);
    end;

    procedure DoHighMenu (item: integer);
        var
            p: procptr;
            i: integer;
    begin
        case item of
            showhs:
                begin
                    ShowWindow(theHigh);
                    SelectWindow(theHigh);
                end;
            clearhs:
                begin
                    if SATQuestionStr(MyGetIndString(sureStrID)) then {str 14: Are you sure you want to erase the high scores?}
                        begin
                            for i := 1 to 10 do
                                begin
                                    hs^^.HighScores[i] := 0;            { skall läsas från fil eller resurs }
                                    hs^^.HighPlayer[i] := MyGetIndString(nobodyStrID); {str 15: Nobody}
                                    hsm^^.HighScores[i] := 0;            { skall läsas från fil eller resurs }
                                    hsm^^.HighPlayer[i] := MyGetIndString(nobodyStrID); {str 15}
                                end;
                            hs^^.HighScores[0] := 10000;            { Lowscore }
                            hsm^^.HighScores[0] := 10000;            { Lowscore }
                            ChangedResource(handle(hs));
                            ChangedResource(handle(hsm));
                            HideWindow(theHigh);
                        end;
                end;
            otherwise
                ;
        end;
    end;

    procedure WindKey (theChar: char; theMods: integer);
    begin
    end;

{ Call this on game over! }
    procedure UpdateHigh;
        var
            num, len: integer;
            name, s: str255;
    begin
        lastMacho := features^^.macho;

        if features^^.macho then
            begin
                if score > hsm^^.HighScores[10] then
                    begin
                        num := 10;
                        name := AskHigh;
                        NumToString(level, s); {used below, to append level number}
{Max 15 characters! We take some extra trouble to append '…' too.}
                        len := length(stringof(' (', s, ')'));
                        if length(name) > 15 - len then
                            name := Concat(Copy(name, 1, 15 - len - 1), '…');

                        if name = '' then { alt length(name) = 0 }
                            exit(updatehigh);
                        while (hsm^^.HighScores[num - 1] < score) and (num > 1) do
                            begin
                                hsm^^.HighScores[num] := hsm^^.HighScores[num - 1];
                                hsm^^.HighPlayer[num] := hsm^^.HighPlayer[num - 1];
                                num := num - 1;
                            end;
                        LastHigh := num; {Remember last high for the highscore display}
                        hsm^^.HighScores[num] := score;
                        hsm^^.HighPlayer[num] := stringof(name, ' (', s, ')'); {AskHigh;}
                        ChangedResource(handle(hsm));
                        HideWindow(theHigh);
                        ShowWindow(theHigh);
                        SelectWindow(theHigh);
                    end;
            end{ if macho }
        else if score > hs^^.HighScores[10] then
            begin
                num := 10;
                name := AskHigh;
                if length(name) > 15 then
                    name := Concat(Copy(name, 1, 14), '…');

                if name = '' then { alt length(name) = 0 }
                    exit(updatehigh);
                while (hs^^.HighScores[num - 1] < score) and (num > 1) do
                    begin
                        hs^^.HighScores[num] := hs^^.HighScores[num - 1];
                        hs^^.HighPlayer[num] := hs^^.HighPlayer[num - 1];
                        num := num - 1;
                    end;
                LastHigh := num; {Remember last high for the highscore display}
                hs^^.HighScores[num] := score;
                hs^^.HighPlayer[num] := name;
                ChangedResource(handle(hs));
                HideWindow(theHigh);
                ShowWindow(theHigh);
                SelectWindow(theHigh);
            end;
    end;

    procedure ZeroScore;
    begin
        score := 0;
        LastHigh := -1;
    end;

{This procedure copies a resource from the file applFile to prefFile (global file numbers,}
{from the unit Preferences).}
{OBSOLETE - should be replaced by the better code in Preferences.p!}
    procedure OldCopyResource (resType: OSType; id: integer);
        var
            h, h2: Handle;
            saveFile: integer;
    begin
        saveFile := CurResFile; {Look where we are so we can restore}
        UseResFile(gAppFile);

        h := GetResource(resType, id); {Get res from the appl}
        if h <> nil then
            begin
                UseResFile(gPrefFile);
                h2 := GetResource(resType, id);
                if h2 = nil then {It doesn't already exist}
                    begin
                        DetachResource(h); {Detach it so we can move it.}
                        AddResource(h, resType, id, ''); {Put it into the gPrefFile}
                        ReleaseResource(h);
                    end
                else {The res always exists. Don't copy.}
                    begin
                        ReleaseResource(h);
                        ReleaseResource(h2);
                    end;
            end;
        UseResFile(saveFile); {restore}
    end;

    procedure InitScores;
        var
            i: integer;
            ignoreErr: OSErr;
    begin
        if SetPrefFile(kPrefsFileName, kPrefCreator, kPrefType, gAppFile, gPrefFile, false) then {If a pref file was created, copy high scores to it!}
            begin
                ignoreErr := CopyResource(gAppFile, gPrefFile, 'Bäst', 0); {Normal mode high scores}
                ignoreErr := CopyResource(gAppFile, gPrefFile, 'Bäst', 1); {Macho mode high scores}
                ignoreErr := CopyResource(gAppFile, gPrefFile, 'Feat', 0); {Settings}
            end
        else
            gPrefFile := gAppFile; {If we have no pref file, let's make sure we UseResFile to something that exists.}

        lastHigh := -1; {no "last"}

        theHigh := GetNewWindow(theHighRes, nil, WindowPtr(-1));
        SetPort(theHigh);
        dummy := SkelWindow(theHigh, nil, @WindKey, @HighUpdate, nil, nil, @HighHalt, nil, false);

        UseResFile(gPrefFile); {set the resfile to the pref file, if any. If none, gPrefFile will be the app itself!}

        hs := hsHnd(GetResource('Bäst', 0));
        if hs = nil then {Didn't exist - create it!}
            begin
                hs := hsHnd(NewHandle(Sizeof(hsRec)));
                CheckNoMem(Ptr(hs));
                for i := 1 to 10 do
                    begin
                        hs^^.HighScores[i] := 0;
                        hs^^.HighPlayer[i] := MyGetIndString(nobodyStrID); {str 15}
                    end;
                hs^^.HighScores[0] := 10000;            { Lowscore }
                AddResource(handle(hs), 'Bäst', 0, 'High scores');
            end
        else {Did exist - check the size!}
            if GetHandleSize(Handle(hs)) < sizeof(hsHnd) then
                SetHandleSize(Handle(hs), sizeof(hsHnd));

        hsm := hsHnd(GetResource('Bäst', 1));
        if hsm = nil then {Didn't exist - create it!}
            begin
                hsm := hsHnd(NewHandle(Sizeof(hsRec)));
                CheckNoMem(Ptr(hsm));
                for i := 1 to 10 do
                    begin
                        hsm^^.HighScores[i] := 0;            { skall läsas från fil eller resurs }
                        hsm^^.HighPlayer[i] := MyGetIndString(nobodyStrID); {str 15}
                    end;
                hsm^^.HighScores[0] := 10000;            { Lowscore }
                AddResource(handle(hsm), 'Bäst', 1, 'High scores');
            end
        else {Did exist - check the size!}
            if GetHandleSize(Handle(hsm)) < sizeof(hsHnd) then
                SetHandleSize(Handle(hsm), sizeof(hsHnd));

        UseResFile(gAppFile);

        score := 0;
    end;

end.